home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
netmail
/
rnr214.zip
/
RNRFUNC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-01
|
68KB
|
2,892 lines
unit rnrfunc;
{
rnrfunc.pas - rnr functions
also see genericf.pas - split off into a separate unit to get around code
segment size limitation
}
{$I rnr-def.pas}
interface
uses dos,genericf,rnrglob,rnrconf,rnrio,rnrfile,rnrnov;
const
yeselevenchars=true;
noelevenchars=false;
yesheadersearch=true;
noheadersearch=false;
couldnotreadfilecookie='(could not read file)';
function basesitename(s: string): string;
function newseqnumber: integer;
function newmessageid: string;
function getalreadyread(s: string): articlefilenametype;
function joinedtogroup(var group: string): boolean;
function expandsource(var source: string; var sourcekind: sourcetype): boolean;
function joinedtoexactgroup(group: string): boolean;
function parseheadername(s: string): string;
function parseheadervalue(s: string): string;
function wafflegetconfig(tag: string): string;
function uupcgetconfig(tag: string): string;
function getconfig(tag: string): string;
function getheaderline(infilename, fieldname: string): string;
function rfcdateheadertodate(datestr: string): datet;
function ymdtodate(yyyymmdd: string): datet;
function datetostring(adate: datet): string;
{var only for efficiency}
function xsubjseq(c1,c2: char; var s1,s2: subjstringt): boolean;
function xfirstsubjg(c1,c2: char; var s1,s2: subjstringt): boolean;
function subjseq(var s1,s2: subjstringt): boolean;
function firstsubjg(var s1,s2: subjstringt): boolean;
function canonicalfirstchar(var subject: subjstringt): char;
function firstartfirst(a,b: integer): boolean; {assuming subjseq() is true}
function isavalidgroup(group: string): boolean;
function getgroupdir(group: string): string;
function groupsattr(group: string; attr: string): string;
function groupbattr(group: string; attr: string): boolean;
function sourcedesc(source: string; sourcekind: sourcetype): string;
function getnextgroup: string;
function importantgroup(group: string): boolean;
function alreadyseen(newsgroups: string): boolean;
function getpwinfoforuser(field164,field165,fieldunix: integer;
someuser: string): string;
function getpwinfo(field164,field165,fieldunix: integer): string;
function getpwinfo164foruser(field: integer; someuser: string): string;
function getpwinfo165foruser(field: integer; someuser: string): string;
function getpwinfounixforuser(field: integer; someuser: string): string;
function getfullnameforuser(someuser: string): string;
function extwafexpand(s: string; percenti: string; percentf: string): string;
function wafexpand(s: string): string;
function makesame(var s: string; prefix,shouldbe: string): boolean;
function chopfirstaddr(var addresses: string): string;
function expandonemail(address: string): string;
function expandmail(addresses: string): string;
function screenline(s: string): string;
function onekey(prompt: string; validkeys: string): char;
function nonhighlightonekey(prompt: string; validkeys: string): char;
function onekeydef(prompt: string; validkeys: string; default: char): char;
function ismailgroup(group: string): boolean;
function isnormalgroup(group: string): boolean;
function getsyscmd(cmd: string): string;
function searchart(filename: string; upsearchtext: string;
headersearch: boolean): boolean;
function searchnov(filename: string; upsearchtext: string): boolean;
function ismoderated(group: string): boolean;
function isheaderinlist(header, uheaderlist: string): boolean;
function getaddressfromline(s: string): string;
function isreasonableaddress(addr: string): boolean;
function nthlayout(whichlayout: integer): layoutt;
{var only for efficiency}
function isabreakline(var s: string): boolean;
function findproblemwithmessage(messagefn: string): string;
function toomuchquoting(messagefn: string): boolean;
function toolongline(messagefn: string; maxlen: integer): boolean;
function showdebug(s: string): boolean;
function unreadarticlesin(asource: string; sourcekind: sourcetype):
articlefilenametype;
function highestreadin(asource: string; sourcekind: sourcetype):
articlefilenametype;
function textintext(asubtext: string; awholetext: string): boolean;
implementation
function pathizegroup(group: string; elevenchars: boolean): string;
var
result: string;
mangledgroup: string;
component: string;
begin
result := '';
mangledgroup := crepl(group,'.',' ');
while mangledgroup<>'' do
begin
component := chopfirstw(mangledgroup);
if length(component)<=8 then
result := result+component
else if elevenchars then
result := result+copy(component,1,8)+'.'+
copy(component, max(9,length(component)-2), 3)
else
result := result+copy(component,1,8);
if mangledgroup<>'' then
result := result+'\';
end;
pathizegroup := result;
end;
function basesitename;
var
result: string;
atbang: integer;
atpercent: integer;
atat: integer;
work: string;
atdot: integer;
begin
result := uucpname;
atbang := pos('!',s);
atpercent := pos('%',s);
atat := pos('@',s);
if atbang>0 then
begin
work := s;
while atbang>0 do
begin
result := copy(work,1,atbang-1);
work := copy(work,atbang+1,255);
atbang := pos('!',work);
end;
end
else if atpercent>0 then
begin
result := copy(s,atpercent+1,255);
atat := pos('@',result);
if atat>0 then
result := copy(result,1,atat-1);
end
else if atat>0 then
begin
result := copy(s,atat+1,255);
end;
atdot := pos('.',result);
if atdot>0 then
result := copy(result,1,atdot-1);
basesitename := result;
end;
function newseqnumber;
var
seqf: text;
seqfn: string;
seqdn: string;
newseq: integer;
begin
newseq := 42;
if xiface=ifacewaffle then
if (ifaceversion='1.64') or (ifaceversion=ifaceversionunix) then
begin
seqdn := configdir+'\system';
seqfn := 'seqf';
end
else
begin
seqdn := configdir+'\uucp';
seqfn := 'sequence';
end
else if xiface=ifaceuupc then
begin
seqdn := configdir+'\uucp';
seqfn := 'sequence';
end
else if xiface=ifaceuufree then
begin
seqdn := configdir+'\uucp';
seqfn := 'sequence';
if not fexists(seqfn) then
begin
seqdn := configdir+'\system';
seqfn := 'seqf';
end;
end;
{} {I think this should be maybemkhier but it's a pain from this low-level code}
{
maybemkhier(seqdn);
}
mkhier(seqdn);
seqfn := withbackslash(seqdn)+seqfn;
safereset(seqf,seqfn);
if fileresult=0 then
begin
readln(seqf,newseq);
close(seqf);
end;
rewrite(seqf);
writeln(seqf,integertozstring(newseq+1,4));
close(seqf);
newseqnumber := newseq;
end;
function newmessageid;
var
result: string;
begin
result := '<'+itoa(year mod 100)+integertozstring(month,2)+
integertozstring(dayofmonth,2)+'.'+currenttimedigits+'.'+
randomdigit+randomletter+randomdigit+'.'+newsreadername;
{preserve waffle's indicator mechanism}
if (xiface=ifacewaffle) and (ifaceversion<>ifaceversionunix) then
result := result+'.'+
'w'+copy(ifaceversion,1,1)+copy(ifaceversion,3,2)+'w'
else
result := result+'.'+fromuserid;
result := result+'@'+fqdn+'>';
newmessageid := result;
end;
function getalreadyread;
begin
getalreadyread := atol(ltrim(trim(copy(s,pos(' ',s)+1,255))));
end;
function closegroup(partial,full: string): boolean;
var
result: boolean;
partwork, fullwork: string;
partat, fullat: integer;
begin
result := false;
if (numoccur('.',partial)=numoccur('.',full)) then
begin
result := true;
partwork := partial+'.';
fullwork := full+'.';
while result and (pos('.',partwork)>0) do
begin
partat := pos('.',partwork);
fullat := pos('.',fullwork);
result := result and
(copy(partwork,1,partat-1)=copy(fullwork,1,partat-1));
if result then
begin
partwork := copy(partwork,partat+1,255);
fullwork := copy(fullwork,fullat+1,255);
end;
end;
end;
closegroup := result;
end;
{joinedtogroup changes the parameter if and only if it isn't joined}
{to, and something else could be found that _is_ joined to}
{it looks for a initials group, or if not a substring group, or if}
{neither a mail folder}
function joinedtogroup;
var
result: boolean;
eachg: string;
newname: string;
subname: string;
mailname: string;
begin
result := false;
newname := '';
subname := '';
mailname := '';
reset(joinf);
while not eof(joinf) and not result do
begin
readln(joinf,eachg);
eachg := getfirstw(eachg);
if eachg=group then
result := true
else
begin
if ismailgroup(eachg) then
begin
if mailname='' then
if closegroup(group,eachg) then
mailname := eachg;
if mailname='' then
if pos(group,eachg)<>0 then
mailname := eachg;
end
else
if newname='' then
if closegroup(group,eachg) then
newname := eachg
else if subname='' then
if pos(group,eachg)<>0 then
subname := eachg;
end;
end;
if not result and (newname<>'') then
begin
group := newname;
result := true;
end;
if not result and (subname<>'') then
begin
group := subname;
result := true;
end;
if not result and (mailname<>'') then
begin
group := mailname;
result := true;
end;
joinedtogroup := result;
end;
function expandsource;
var
result: boolean;
unslashed: string;
begin
result := false;
unslashed := unslash(source);
if joinedtogroup(source) then
begin
sourcekind := sourcegroup;
result := true;
end
else if trusted then
if dexists(unslashed) then
begin
source := unslashed;
sourcekind := sourcedir;
result := true;
end;
expandsource := result;
end;
function joinedtoexactgroup;
var
result: boolean;
eachg: string;
begin
result := false;
reset(joinf);
while not eof(joinf) and not result do
begin
readln(joinf,eachg);
eachg := getfirstw(eachg);
if eachg=group then
result := true
end;
joinedtoexactgroup := result;
end;
function parseheadername;
begin
parseheadername := copy(s,1,pos(':',s)-1);
end;
function parseheadervalue;
begin
parseheadervalue := copy(s,pos(':',s)+2,255);
end;
function wafflegetconfig;
var
result: string;
infile: text;
s: string;
foundtag: string;
begin
result := '';
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
if customstatic<>'' then
begin
safereset(infile,customstatic);
if fileresult=0 then
begin
while (result='') and not eof(infile) do
begin
readln(infile,s);
if s<>'' then
if copy(s,1,1)<>'#' then
begin
foundtag := trim(ltrim(lower(parseheadername(s))));
if foundtag=tag then
begin
result := trim(ltrim(parseheadervalue(s)));
end;
end;
end;
close(infile);
end;
end;
if result='' then
begin
safereset(infile,wafenv);
if fileresult=0 then
begin
while (result='') and not eof(infile) do
begin
readln(infile,s);
if s<>'' then
if copy(s,1,1)<>'#' then
begin
foundtag := lower(trim(ltrim(parseheadername(s))));
if foundtag=tag then
begin
result := trim(ltrim(parseheadervalue(s)));
end;
end;
end;
close(infile);
end;
end;
filemode := oldfilemode;
wafflegetconfig := result;
end;
function uupcgetoneconfig(fn: string; tag: string): string;
var
result: string;
infile: text;
s: string;
foundtag: string;
begin
result:= '';
if fn<>'' then
begin
safereset(infile,fn);
if fileresult=0 then
begin
while (result='') and not eof(infile) do
begin
readln(infile,s);
if s<>'' then
if copy(s,1,1)<>'#' then
begin
foundtag := trim(ltrim(copy(s,1,pos('=',s)-1)));
if lower(foundtag)=tag then
result := trim(ltrim(copy(s,pos('=',s)+1,255)));
end;
end;
close(infile);
end;
end;
uupcgetoneconfig:= result;
end;
function uupcgetconfig(tag: string): string;
var
result: string;
begin
result := '';
result := uupcgetoneconfig(uupcusr,tag);
if result='' then
result := uupcgetoneconfig(uupcsys,tag);
uupcgetconfig := result;
end;
procedure changetag(var changed: boolean; var tag: string;
basetag: string; waffletag, uupctag, othertag: string);
begin
if not changed then
if tag=basetag then
begin
tag := othertag;
if xiface=ifacewaffle then
tag := waffletag
else if xiface=ifaceuupc then
tag := uupctag
else if xiface=ifaceuufree then
tag := waffletag;
end;
end;
function getconfig;
const
x='';
var
result: string;
n: string;
c: boolean;
begin
result := x;
n := tag;
c := false;
{ changed,base tag ,waffle tag ,uupc tag ,other tag }
changetag(c,n,'tempdir' ,'temporary','tempdir' ,x);
changetag(c,n,'mailbox' ,x ,'mailbox' ,x);
changetag(c,n,'fqdn' ,'node' ,'domain' ,x);
changetag(c,n,'uucpname' ,'uucpname' ,'nodename' ,x);
changetag(c,n,'spooldir' ,'spool' ,'spool' ,x);
changetag(c,n,'userdir' ,'user' ,'user' ,x);
changetag(c,n,'outboxdir','outbox' ,'outbox' ,x);
changetag(c,n,'configdir','waffle' ,'confdir' ,x);
changetag(c,n,'fullname' ,x ,'name' ,x);
changetag(c,n,'home' ,x ,'home' ,x);
changetag(c,n,'smarthost','smarthost','mailserv' ,x);
changetag(c,n,'backbone' ,'backbone' ,'backbone' ,x);
changetag(c,n,'organ' ,'organ' ,'organization',x);
changetag(c,n,'replyto' ,'replyto' ,'replyto' ,x);
changetag(c,n,'newsroot' ,x ,'newsdir' ,x);
if n<>x then
if xiface=ifacewaffle then
result := wafflegetconfig(n)
else if xiface=ifaceuupc then
result := uupcgetconfig(n)
else if xiface=ifaceuufree then
result := wafflegetconfig(n);
getconfig := result;
end;
function getheaderline;
var
result: string;
infile: file;
foundline: boolean;
s: string;
ufieldname: string;
headerbytesseen: integer;
morelinesinheader: boolean;
wastes: string;
i,j: integer;
function nextlinefrombuf: string;
var
result: string;
gotlf: boolean;
c: char;
begin {nextlinefrombuf}
result := '';
gotlf := false;
while (headerbytesseen<headerbytesinmem) and not gotlf do
begin
inc(headerbytesseen);
c := headerbuf[headerbytesseen];
if (c=lf) then
gotlf := true
else if c<>cr then
result := result+c;
end;
nextlinefrombuf := result;
end; {nextlinefrombuf}
begin
result := '';
ufieldname := upper(fieldname);
foundline := false;
if headerinmem<>infilename then
begin
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
assign(infile,infilename);
{$I-}
reset(infile,1);
{$I+}
if ioresult=0 then
begin
blockread(infile,headerbuf,headerbufsize,headerbytesinmem);
headerinmem := infilename;
close(infile);
end
else
begin
for i := 1 to headerbufsize do
headerbuf[i] := ' ';
result := couldnotreadfilecookie;
foundline := true;
end;
filemode := oldfilemode;
for i := 1 to headertlsize do
begin
headertrackedlines[i].first := #0;
headertrackedlines[i].offset := -1;
end;
headertrackedlines[1].first := upcase(headerbuf[1]);
headertrackedlines[1].offset := 1;
j := 1;
i := 0;
while (i<headerbufsize-2) and (j<headertlsize) do
begin
inc(i);
if headerbuf[i]=lf then
if headerbuf[i+2]=lf then
i := headerbufsize {found the empty line}
else
begin
inc(j);
headertrackedlines[j].first := upcase(headerbuf[i+1]);
headertrackedlines[j].offset := i+1;
end;
end;
{$ifdef testfastheaders}
for i := 1 to min(10,headertlsize) do
writeln(headertrackedlines[i].offset:3,' ',headertrackedlines[i].first);
delay(1000);
{$endif}
end;
{$ifdef veryoldheader}
foundblank := false;
while not eof(f) and not foundblank and not foundline do
begin
readln(f,s);
if copy(upper(ltrim(s)),1,length(fieldname))=ufieldname then
begin
foundline := true;
result := ltrim(trim(copy(trim(s),length(fieldname)+1,255)));
if not eof(f) then
begin
readln(f,s);
if copy(s,1,1)=' ' then
result := result+s;
end;
end
else if s='' then
foundblank := true;
end;
close(f);
{$endif}
{$ifdef oldheader}
foundblank := false;
headerbytesseen := 0;
while (headerbytesseen<headerbytesinmem) and
not foundblank and not foundline do
begin
s := nextlinefrombuf;
if copy(upper(ltrim(s)),1,length(fieldname))=ufieldname then
begin
foundline := true;
result := ltrim(trim(copy(trim(s),length(fieldname)+1,255)));
if headerbytesseen<headerbytesinmem then
begin
morelinesinheader := true;
while morelinesinheader do
begin
s := nextlinefrombuf;
if (copy(s,1,1)=' ') or (copy(s,1,1)=tab) then
begin
s := ltrim(s);
{handle References: line specially - always get the last part}
if ufieldname='REFERENCES:' then
begin
if length(s)>200 then
result := s
else
begin
if length(result)+length(s)>200 then
wastes := chopfirstw(result);
if length(result)+length(s)>200 then
wastes := chopfirstw(result);
if length(result)+length(s)>200 then
wastes := chopfirstw(result);
if length(result)+length(s)>200 then
wastes := chopfirstw(result);
result := result+' '+s;
end;
end
else
result := result+' '+s;
end
else
morelinesinheader := false;
end;
end;
end
else if s='' then
foundblank := true;
end;
{$endif}
j := 0;
while (j<headertlsize) and not foundline do
begin
inc(j);
if headertrackedlines[j].first=ufieldname[1] then
begin
headerbytesseen := headertrackedlines[j].offset-1;
s := nextlinefrombuf;
if copy(upper(ltrim(s)),1,length(fieldname))=ufieldname then
begin
foundline := true;
result := ltrim(copy(trim(s),length(fieldname)+1,255));
if headerbytesseen<headerbytesinmem then
begin
morelinesinheader := true;
while morelinesinheader do
begin
s := nextlinefrombuf;
if (copy(s,1,1)=' ') or (copy(s,1,1)=tab) then
begin
s := ltrim(s);
{handle References: line specially - always get the last part}
if ufieldname='REFERENCES:' then
begin
if length(result)+length(s)>200 then
wastes := chopfirstw(result);
result := result+' '+s;
end
else
result := result+' '+s;
end
else
morelinesinheader := false;
end;
end;
end;
end;
end;
getheaderline := result;
end;
{}{} {doesn't handle time zones at all - but at least when a user}
{posts twice on the same day, the tz will be the same each time}
{and thus correctly ordered for that user's posts}
function rfcdateheadertodate;
var
result: datet;
workstr: string;
dayofmonth: longint;
monthstr: string;
month: longint;
year: longint;
gmthour: longint;
begin
result := 9999*16384;
if datestr<>'' then
begin
workstr := datestr;
dayofmonth := snatchint(workstr);
workstr := ltrim(workstr);
monthstr := copy(workstr,1,3);
month := monthstringtointeger(monthstr);
workstr := ltrim(lchop(workstr,4));
year := snatchint(workstr);
if year<100 then
inc(year,1900);
gmthour := snatchint(workstr);
result := year*16384+month*1024+dayofmonth*32+gmthour;
end;
rfcdateheadertodate := result;
end;
function ymdtodate;
var
result: datet;
workstr: string;
dayofmonth: longint;
month: longint;
year: longint;
gmthour: longint;
begin
result := 9999*16384;
if yyyymmdd<>'' then
begin
workstr := yyyymmdd;
year := snatchint(workstr);
month := snatchint(workstr);
dayofmonth := snatchint(workstr);
if year<100 then
inc(year,1900);
gmthour := 0;
result := year*16384+month*1024+dayofmonth*32+gmthour;
end;
ymdtodate := result;
end;
function datetostring(adate: datet): string;
var
result: string;
begin
datetostring := ymdtostring(
adate div 16384,
(adate mod 16384) div 1024,
(adate mod 1024) div 32);
end;
{var only for efficiency}
function canonicalsubj(var subject: subjstringt): subjstringt;
var
result: subjstringt;
tempstr: string;
i: integer;
begin
result := '';
if subjectlength=255 then
result := subject
else
result := copy(subject,1,subjectlength);
if subjectscaseinsensitive then
result := upper(result);
if squashspaces then
begin
tempstr := '';
for i := 1 to length(result) do
if (result[i]<>' ') and (result[i]<>tab) then
tempstr := tempstr+result[i];
result := tempstr;
end;
canonicalsubj := result;
end;
{var only for efficiency}
{no longer used, since every time I call it I already have canonicalsubj}
function canonicalfirstchar;
var
result: char;
tempi: integer;
begin
result := ' ';
if subject<>'' then
begin
if not squashspaces then
result := subject[1]
else
begin
{$ifdef slow}
tempstr := ltrim(subject)+' '; {if it's empty, return space}
result := tempstr[1];
{$endif}
for tempi := 1 to length(subject) do
if (result=' ') and (subject[tempi]<>tab) then
result := subject[tempi];
end;
if subjectscaseinsensitive then
result := upcase(result);
end;
canonicalfirstchar := result;
end;
{var only for efficiency}
{ string comparison for the shorter string -- unless it's empty }
function subjshortequal(var s1,s2: subjstringt): boolean;
var
result: boolean;
len1: integer;
len2: integer;
begin
result := false;
len1 := length(s1);
len2 := length(s2);
if (len1=0) and (len2=0) then
result := true
else if (len1=0) or (len2=0) then
result := false
else if len1=len2 then
result := (s1=s2)
else if (len1<len2) and (len1>=equatetruncated) then
result := (s1=copy(s2,1,len1))
else if (len2<len1) and (len2>=equatetruncated) then
result := (copy(s1,1,len2)=s2)
else
result := false; {lengths aren't the same, so can't be equal}
subjshortequal := result;
end;
{s1 and s2 var for efficiency}
procedure copytocanon(var s1,s2: subjstringt; var canon1,canon2: subjstringt);
begin
canon1 := canonicalsubj(s1);
canon2 := canonicalsubj(s2);
end;
function xsubjseq;
var
result: boolean;
canon1,canon2: subjstringt;
begin
result := false;
if equatetruncated<>0 then
begin
if (s1='') or (s2='') or (c1=c2) then
begin
copytocanon(s1,s2,canon1,canon2);
result := subjshortequal(canon1,canon2);
end
else
result := false;
end
else
begin
if (s1='') or (s2='') or (c1=c2) then
begin
copytocanon(s1,s2,canon1,canon2);
result := (canon1=canon2);
end
else
result := false;
end;
xsubjseq := result;
end;
function xfirstsubjg;
var
result: boolean;
canon1: subjstringt;
canon2: subjstringt;
begin
result := false;
if (s1='') or (s2='') then
begin
copytocanon(s1,s2,canon1,canon2);
result := (canon1>canon2);
end
else if c1<c2 then
result := false
else
begin
copytocanon(s1,s2,canon1,canon2);
result := (canon1>canon2);
if equatetruncated<>0 then
result := result and not subjshortequal(canon1,canon2);
end;
xfirstsubjg := result;
end;
function subjseq;
var
c1,c2: char;
begin
c1 := canonicalfirstchar(s1);
c2 := canonicalfirstchar(s2);
subjseq := xsubjseq(c1,c2,s1,s2);
end;
function firstsubjg;
var
c1,c2: char;
begin
c1 := canonicalfirstchar(s1);
c2 := canonicalfirstchar(s2);
firstsubjg := xfirstsubjg(c1,c2,s1,s2);
end;
function hasheq(h1,h2: hashedt): boolean;
begin
hasheq := (h1[1]=h2[1]) and (h1[2]=h2[2]);
end;
function firstartfirst;
var
result: boolean;
begin
result := true;
{$ifdef testhash}
if true then
begin
writeln('#',a,' mes=',hmessageidsp^[a,1]:5,' ',hmessageidsp^[a,2]:5);
writeln('#',a,' ref=',
hreferencesp[1]^[a,1]:5,' ',hreferencesp[1]^[a,2]:5,' ',
hreferencesp[2]^[a,1]:5,' ',hreferencesp[2]^[a,2]:5,' ',
hreferencesp[3]^[a,1]:5,' ',hreferencesp[3]^[a,2]:5,' ',
hreferencesp[4]^[a,1]:5,' ',hreferencesp[4]^[a,2]:5);
writeln('#',b,' mes=',hmessageidsp^[b,1]:5,' ',hmessageidsp^[b,2]:5);
writeln('#',b,' ref=',
hreferencesp[1]^[b,1]:5,' ',hreferencesp[1]^[b,2]:5,' ',
hreferencesp[2]^[b,1]:5,' ',hreferencesp[2]^[b,2]:5,' ',
hreferencesp[3]^[b,1]:5,' ',hreferencesp[3]^[b,2]:5,' ',
hreferencesp[4]^[b,1]:5,' ',hreferencesp[4]^[b,2]:5);
if hasheq(hmessageidsp^[b],hreferencesp[1]^[a]) then
writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
else if hasheq(hmessageidsp^[b],hreferencesp[2]^[a]) then
writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
else if hasheq(hmessageidsp^[b],hreferencesp[3]^[a]) then
writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
else if hasheq(hmessageidsp^[b],hreferencesp[4]^[a]) then
writeln('#',b,' ',filenamesp^[b],' before #',a,' ',filenamesp^[a])
else
writeln('#',b,' ',filenamesp^[b],' not refd by #',a,' ',filenamesp^[a]);
if hasheq(hmessageidsp^[a],hreferencesp[1]^[b]) then
writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
else if hasheq(hmessageidsp^[a],hreferencesp[2]^[b]) then
writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
else if hasheq(hmessageidsp^[a],hreferencesp[3]^[b]) then
writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
else if hasheq(hmessageidsp^[a],hreferencesp[4]^[b]) then
writeln('#',a,' ',filenamesp^[a],' before #',b,' ',filenamesp^[b])
else
writeln('#',a,' ',filenamesp^[a],' not refd by #',b,' ',filenamesp^[b]);
end;
{$endif}
if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[1]) then
result := false
else if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[2]) then
result := false
else if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[3]) then
result := false
else if hasheq(articles[b]^.hmessageid,articles[a]^.hreferences[4]) then
result := false
else
if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[1]) then
if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[2]) then
if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[3]) then
if not hasheq(articles[a]^.hmessageid,articles[b]^.hreferences[4]) then
begin
{no conclusive proof - just guess}
if articles[a]^.date>articles[b]^.date then
result := false
else if articles[a]^.date=articles[b]^.date then
if
(articles[a]^.indents and $f)
>
(articles[b]^.indents and $f) then
result := false;
end;
{$ifdef testsort}
if showdebug('sort') then
begin
write('firstartfirst(',a,'(',articles[a]^.filename:5,')',',',
b,'(',articles[b]^.filename:5,')',')=');
if result then writeln('true') else writeln('false');
{$ifdef pauseintestsort}
xwrites('pausing...');
xwritelns(xreadkey);
{$endif}
end;
{$endif}
firstartfirst := result;
end;
{need to use an ACTIVE file on those which have them}
function isavalidgroup;
begin
isavalidgroup := (getgroupdir(group)<>'');
end;
function wafflefogetgroupdir(group: string; forumset: string): string;
var
result: string;
infilen: string;
infile: text;
s: string;
foundgroup: boolean;
default: string;
defaultdir: string;
begin
result := '';
foundgroup := false;
default := '';
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
infilen := configdir+'\system\'+forumset;
safereset(infile,infilen);
if fileresult=0 then
begin
while not foundgroup and not eof(infile) do
begin
readln(infile,s);
foundgroup := (getfirstw(s)=group);
if pos('/dir=',s)>0 then
begin
if getfirstw(s)=group then
begin
result := trim(ltrim(copy(s,pos('/dir=',s)+5,255)));
result := unquote(getfirstw(unslash(result)));
end
else if getfirstw(s)='DEFAULT' then
default := s;
end;
end;
close(infile);
end;
filemode := oldfilemode;
if (result='') and (default<>'') and foundgroup then
begin
defaultdir := trim(ltrim(copy(default,pos('/dir=',default)+5,255)));
defaultdir := unquote(getfirstw(unslash(defaultdir)));
{waffle treats /dir=x: to mean /dir=x:\ anyway}
defaultdir := withbackslash(defaultdir);
result := defaultdir+pathizegroup(group,noelevenchars);
end;
wafflefogetgroupdir := result;
end;
function secondarygetgroupdir(group: string): string;
var
result: string;
forumset: string;
mungedl: string;
begin
result := '';
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
begin
mungedl := forumsetl;
while (result='') and (mungedl<>'') do
begin
forumset := chopfirstw(mungedl);
result := wafflefogetgroupdir(group,forumset);
end;
end
else if xiface=ifaceuupc then
begin
result := withbackslash(getconfig('newsroot'))+
pathizegroup(group,yeselevenchars);
end;
secondarygetgroupdir := result;
end;
function getgroupdir;
var
result: string;
nonprefix: string;
partialprefix: string;
i: integer;
begin
result := '';
if ismailgroup(group) then
begin
{partialprefix is mailprefix without the `.userid' bits}
partialprefix := copy(group,1,length(mailprefix)-1-length(userid));
if group=mailprefix then
begin
{look for just partialprefix, and add individual user ids on after}
result := secondarygetgroupdir(partialprefix);
if result<>'' then
result := withbackslash(result)+userid;
end
else
begin
{must be a folder}
{look for user's home mail directory, then add folders onto end}
nonprefix := copy(group,length(mailprefix)+2,255); { lose the . }
nonprefix := crepl(nonprefix,'.','\');
result := getgroupdir(partialprefix);
if result<>'' then
result := withbackslash(result)+userid+'\'+nonprefix;
end;
end;
if result='' then
result := secondarygetgroupdir(group);
getgroupdir := result;
end;
{}{}{}{} {need to make sure it's not inside some option's path}
function fogroupsattr(group: string; attr: string; forumset: string): string;
var
result: string;
infilen: string;
infile: text;
s: string;
foundgroup: boolean;
default: string;
begin
result := '';
foundgroup := false;
default := '';
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
infilen := configdir+'\system\'+forumset;
safereset(infile,infilen);
if fileresult=0 then
begin
while not foundgroup and not eof(infile) do
begin
readln(infile,s);
foundgroup := (getfirstw(s)=group);
if pos(attr,s)>0 then
begin
if foundgroup then
result :=
getfirstw(trim(ltrim(copy(s,pos(attr,s)+length(attr),255))))
else if getfirstw(s)='DEFAULT' then
default := s;
end;
end;
close(infile);
end;
filemode := oldfilemode;
if (result='') and (default<>'') and foundgroup then
result :=
getfirstw(trim(ltrim(copy(default,pos(attr,default)+length(attr),255))));
fogroupsattr := result;
end;
function groupsattr;
var
result: string;
forumset: string;
mungedl: string;
begin
result := '';
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
begin
mungedl := forumsetl;
while (result='') and (mungedl<>'') do
begin
forumset := chopfirstw(mungedl);
result := fogroupsattr(group,attr,forumset);
end;
end;
groupsattr := result;
end;
{}{}{}{} {need to make sure it's not inside some option's path}
function fogroupbattr(group: string; attr: string; forumset: string): boolean;
var
result: boolean;
infilen: string;
infile: text;
s: string;
foundgroup: boolean;
default: string;
begin
result := false;
foundgroup := false;
default := '';
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
infilen := configdir+'\system\'+forumset;
safereset(infile,infilen);
if fileresult=0 then
begin
while not foundgroup and not eof(infile) do
begin
readln(infile,s);
foundgroup := (getfirstw(s)=group);
if pos(attr,s)>0 then
begin
if foundgroup then
result := true
else if getfirstw(s)='DEFAULT' then
default := s;
end;
end;
close(infile);
end;
filemode := oldfilemode;
if (default<>'') and foundgroup then
result := true;
fogroupbattr := result;
end;
function groupbattr;
var
result: boolean;
forumset: string;
mungedl: string;
begin
result := false;
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
begin
mungedl := forumsetl;
while not result and (mungedl<>'') do
begin
forumset := chopfirstw(mungedl);
result := fogroupbattr(group,attr,forumset);
end;
end;
groupbattr := result;
end;
function fogroupdesc(group: string; forumset: string): string;
var
result: string;
infilen: string;
infile: text;
s: string;
foundgroup: boolean;
begin
result := '';
foundgroup := false;
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
infilen := configdir+'\words\'+forumset;
safereset(infile,infilen);
if fileresult=0 then
begin
while not foundgroup and not eof(infile) do
begin
readln(infile,s);
foundgroup := (chopfirstw(s)=group);
if foundgroup then
result := s;
end;
close(infile);
end;
filemode := oldfilemode;
fogroupdesc := result;
end;
function groupdesc(group: string): string;
var
result: string;
forumset: string;
mungedl: string;
begin
result := '';
if ismailgroup(group) then
result := 'mail folder';
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
begin
mungedl := forumsetl;
while (result='') and (mungedl<>'') do
begin
forumset := chopfirstw(mungedl);
result := fogroupdesc(group,forumset);
end;
end;
if result='' then
result := '(unknown description)';
groupdesc := result;
end;
function sourcedesc;
begin
if sourcekind=sourcegroup then
sourcedesc := groupdesc(source)
else if sourcekind=sourcedir then
sourcedesc := 'directory'
else if sourcekind=sourcefolder then
sourcedesc := 'folder'
else
sourcedesc := '(internal error)'
end;
function getnextgroup: string;
var
foundgroup: string;
result: string;
begin
{}{} {this should use joinedgroups[] if possible}
result := '';
reset(joinf);
foundgroup := '';
if not eof(joinf) then
begin
if currsource='' then
begin
readln(joinf,foundgroup);
result := getfirstw(foundgroup);
end
else
begin
while not eof(joinf) and (foundgroup<>currsource) do
begin
readln(joinf,foundgroup);
foundgroup := getfirstw(foundgroup);
end;
{if we were reading a group we weren't joined to, restart from top}
if foundgroup<>currsource then
reset(joinf);
if not eof(joinf) then
begin
readln(joinf,foundgroup);
result := getfirstw(foundgroup);
end;
end;
end;
getnextgroup := result;
end;
function importantgroup;
var
result: boolean;
begin
result :=
(copy(group,1,14)='news.announce.') or
((numoccur('.',group)=1) and (right(group,8)='.answers'));
importantgroup := result;
end;
function alreadyseen;
var
result: boolean;
i: integer;
newsglist: string;
found: boolean;
begin
result := false;
if (currsource<>'control') and (currsource<>'monitor') and
not importantgroup(currsource) then
begin
newsglist := ','+newsgroups+',';
if pos(','+currsource+',' , newsglist)<>0 then {for news moved by hand}
begin
found := false;
i := 1;
while (i<numjoined) and not found do
begin
if not importantgroup(joinedgroups[i]) and
(pos(','+joinedgroups[i]+',',newsglist)<>0) then
begin
found := true;
result := (joinedgroups[i]<>currsource);
end;
inc(i);
end;
end;
end;
alreadyseen := result;
end;
function getpwinfo;
begin
getpwinfo := getpwinfoforuser(field164,field165,fieldunix,userid);
end;
function getpwinfoforuser;
var
result: string;
begin
result := '{internal error}';
if xiface=ifaceuufree then
result := getpwinfounixforuser(fieldunix,someuser)
else if ifaceversion=ifaceversionunix then
result := getpwinfounixforuser(fieldunix,someuser)
else if ifaceversion='1.64' then
result := getpwinfo164foruser(field164,someuser)
else if ifaceversion>='1.65' then
result := getpwinfo165foruser(field165,someuser)
else
result := '{unknown ifaceversion: '+ifaceversion+'}';
getpwinfoforuser := result;
end;
function getpwinfo164foruser;
const
passwordblocksize=256;
type
passwordbuft=array[1..passwordblocksize] of char;
var
result: string;
passwordbuf: passwordbuft;
passwordf: file;
found: boolean;
function passwordentry164(fieldnum: integer): string;
var
i: integer;
lfs: integer;
result: string;
begin
result := '';
lfs := 0;
for i := 1 to passwordblocksize do
begin
if passwordbuf[i]=lf then
inc(lfs);
if (lfs=fieldnum) and (passwordbuf[i]<>lf) then
result := result+passwordbuf[i];
end;
passwordentry164 := result;
end;
begin
result := '';
found := false;
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
assign(passwordf,configdir+'\admin\'+'password');
{$I-}
reset(passwordf,1);
{$I+}
if ioresult=0 then
begin
blockread(passwordf,passwordbuf,passwordblocksize);
while not found and not eof(passwordf) do
begin
blockread(passwordf,passwordbuf,passwordblocksize);
if passwordentry164(0)=someuser then
begin
result := passwordentry164(field);
found := true;
end;
end;
close(passwordf);
end;
filemode := oldfilemode;
getpwinfo164foruser := result;
end;
function getpwinfo165foruser;
const
passwordblocksize=1024;
type
passwordbuft=array[1..passwordblocksize] of char;
var
result: string;
passwordbuf: passwordbuft;
passwordf: file;
found: boolean;
function fieldsize165(fieldnum: integer): integer;
var
result: integer;
begin
result := 0;
case fieldnum of
1: result := 12; {name}
2: result := 12; {pass}
3: result := 24; {identity} {I'm told _this_ is the one for %W}
4: result := 24; {realname}
5: result := 22; {phone}
6: result := 40; {shell}
7: result := 10; {editor}
8: result := 10; {console}
9: result := 66; {comment}
10: result := 8; {level}
11: result := 10; {terminal}
12: result := 10; {language}
13: result := 10; {suite}
14: result := 10; {account}
15: result := 12; {group}
16: result := 2; {access}
17: result := 8; {priv}
18: result := 12; {age}
19: result := 2; {color}
20: result := 5; {encryption}
21: result := 8; {help}
end;
fieldsize165 := result;
end;
function fieldstart165(fieldnum: integer): integer;
var
i: integer;
result: integer;
begin
result := 0;
for i := 1 to fieldnum-1 do
inc(result,fieldsize165(i));
fieldstart165 := result;
end;
function passwordentry165(fieldnum: integer): string;
var
result: string;
i: integer;
start: integer;
size: integer;
ch: char;
done: boolean;
begin
result := '';
size := fieldsize165(fieldnum);
start := fieldstart165(fieldnum);
done := false;
i := 1;
while (i<=size) and not done do
begin
ch := passwordbuf[i+start];
if ch=#0 then
done := true
else
result := result+ch;
inc(i);
end;
passwordentry165 := result;
end;
begin
result := '';
found := false;
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
assign(passwordf,configdir+'\admin\'+'password');
{$I-}
reset(passwordf,1);
{$I-}
if ioresult=0 then
begin
blockread(passwordf,passwordbuf,passwordblocksize);
while not found and not eof(passwordf) do
begin
blockread(passwordf,passwordbuf,passwordblocksize);
if passwordentry165(1)=someuser then
begin
result := passwordentry165(field);
found := true;
end;
end;
close(passwordf);
end;
filemode := oldfilemode;
getpwinfo165foruser := result;
end;
function getpwinfounixforuser;
var
result: string;
passwordf: text;
passwordline: string;
found: boolean;
chopfieldcount: integer;
begin
result := '';
found := false;
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
safereset(passwordf,configdir+'\etc\'+'passwd');
if fileresult=0 then
begin
while not found and not eof(passwordf) do
begin
readln(passwordf,passwordline);
if copy(passwordline,1,length(someuser)+1)=someuser+':' then
begin
for chopfieldcount := 1 to field-1 do
passwordline :=
copy(passwordline,pos(':',passwordline)+1,255);
passwordline := passwordline+':';
result := copy(passwordline,1,pos(':',passwordline)-1);
found := true;
end;
end;
close(passwordf);
end;
filemode := oldfilemode;
getpwinfounixforuser := result;
end;
{someuser needs to be lowercase for waffle, and probably uupc}
function getfullnameforuser(someuser: string): string;
var
result: string;
begin
result := '';
if (result='') and ((xiface=ifacewaffle) or (xiface=ifaceuufree)) then
result := trim(getpwinfoforuser(5,3,5,someuser));
{uupc only has full-name info for current user}
if (result='') and (someuser=userid) and (xiface=ifaceuupc) then
result := getconfig('fullname');
{environment only has full-name info for current user}
if (result='') and (someuser=userid) and not ignoreenvironment then
result := trim(ununderscore(getenv('FULLNAME')));
getfullnameforuser := result;
end;
function extwafexpand;
var
result: string;
tempint: integer;
tempchar: char;
begin
if pos('%',s)=0 then
result := s
else
begin
result := '';
tempint := 1;
while tempint<=length(s) do
begin
if (s[tempint]<>'%') or (tempint=length(s)) then
result := result+s[tempint]
else
begin
inc(tempint);
tempchar := s[tempint];
case tempchar of
'%': result := result+'%';
'^': result := result+'^';
'A': result := result+userid;
'W': result := result+fullname;
'n': result := result+fqdn;
'u': result := result+uucpname;
'F': result := result+trim(getpwinfo(5,4,5));
'i': result := result+percenti;
{%f is non-standard!}
'f': result := result+percentf;
{%_ will be in waffle 1.66}
'_': result := result+crepl(fullname,' ','_');
else result := result+'{unknown flag %'+tempchar+'}';
end;
end;
inc(tempint);
end;
end;
extwafexpand := result;
end;
function wafexpand;
begin
wafexpand := extwafexpand(s,'{error}','{error}');
end;
function makesame;
var
result: boolean;
begin
result := false;
if copy(s,1,length(prefix))=prefix then
if s<>prefix+shouldbe then
begin
s := prefix+shouldbe;
result := true;
end;
makesame := result;
end;
function chopfirstaddr;
var
result: string;
inquote: boolean;
charlookingat: integer;
done: boolean;
begin
result := '';
inquote := false;
charlookingat := 1;
done := false;
while not done do
begin
if charlookingat>length(addresses) then
begin
{only one address in the list}
done := true;
result := addresses;
addresses := '';
end
else if addresses[charlookingat]='"' then
begin
{it's a quote}
inquote := not inquote;
end
else if (addresses[charlookingat]=',') and not inquote then
begin
{it's a non-quoted separator -- remove the separator and split}
done := true;
result := copy(addresses,1,charlookingat-1);
addresses := copy(addresses,charlookingat+1,255);
end;
inc(charlookingat);
end;
if inquote then
begin
{ there's definitely an error if the quote never got closed }
{}{}{}{}
writeln('error -- " never got closed');
end;
result := trim(ltrim(result));
chopfirstaddr := result;
end;
function expandonemail;
var
result: string;
newaddressfn: string;
newaddressf: text;
changed: boolean;
s: string;
begin
result := address;
changed := false;
if (pos('@',address)=0) and
(pos('!',address)=0) and
(pos(' ',address)=0) then
begin
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
newaddressfn := configdir+'\system\'+'aliases'
else if xiface=ifaceuupc then
begin
newaddressfn := unslash(getconfig('aliases'));
if newaddressfn='' then
newaddressfn := home+'\aliases'
else if numoccur('\',newaddressfn)=0 then
newaddressfn := withbackslash(home)+newaddressfn;
end
else
newaddressfn := 'aliases';
oldfilemode := filemode;
if not nofilemode then
filemode := $40; {read only, deny none}
safereset(newaddressf,newaddressfn);
if fileresult=0 then
begin
while not changed and not eof(newaddressf) do
begin
readln(newaddressf,s);
if lower(chopfirstw(s))=lower(address) then
begin
changed := true;
result := s;
end;
end;
close(newaddressf);
end;
if not changed then
begin
newaddressfn := home+'\aliases';
safereset(newaddressf,newaddressfn);
if fileresult=0 then
begin
while not changed and not eof(newaddressf) do
begin
readln(newaddressf,s);
if lower(chopfirstw(s))=lower(address) then
begin
changed := true;
result := s;
end;
end;
close(newaddressf);
end;
end;
if not changed then
begin
{make sure no chance of security hole - no .. or \ or / or : in address}
{don't need to make sure it's not a device - last part of name is always}
{the string 'forward'}
if (pos('/',address)=0) and (pos(':',address)=0) and
(pos('\',address)=0) and (pos('..',address)=0) then
begin
newaddressfn := withbackslash(userdir)+address+'\forward';
safereset(newaddressf,newaddressfn);
if fileresult=0 then
begin
if not eof(newaddressf) then
begin
changed := true;
readln(newaddressf,result);
end;
close(newaddressf);
end;
end;
end;
filemode := oldfilemode;
end;
expandonemail := result;
end;
function expandmail;
var
result: string;
separator: string;
mangledaddresses: string;
oneaddress: string;
onebareaddress: string;
alladdresses: string;
begin
result := '';
alladdresses := addresses;
{}{} {not perfect if you have quoting, but fairly good considering it's}
{illegal to begin with}
{change `chris pat' into `chris, pat' for expansion}
{change `chris pat,sam' into `chris, pat, sam' for expansion}
if (pos('@',alladdresses)=0) and (pos('!',alladdresses)=0) and
(pos('(',alladdresses)=0) and (pos('"',alladdresses)=0) then
begin
mangledaddresses := uncomma(alladdresses);
alladdresses := '';
separator := '';
while mangledaddresses<>'' do
begin
oneaddress := chopfirstw(mangledaddresses);
alladdresses := alladdresses+separator+oneaddress;
separator := ', ';
end;
end;
separator := '';
mangledaddresses := alladdresses;
while mangledaddresses<>'' do
begin
oneaddress := chopfirstaddr(mangledaddresses);
onebareaddress := getfromaddr(oneaddress);
result := result+separator+expandonemail(onebareaddress);
separator := ', ';
end;
result := ltrim(trim(result));
expandmail := result;
end;
function screenline;
begin
screenline := trim(expand(s));
end;
function extonekey(highlight: boolean; prompt: string;
validkeys: string): char;
var
result: char;
i: integer;
begin
result := ' ';
xclreolxy(1,lpp);
if highlight then
xwritehighlights(prompt)
else
xwrites(prompt);
xwrites(' ');
repeat
result := xreadkey;
until pos(result,validkeys)<>0;
{caller has to clear line after - might not want to right away}
extonekey := result;
end;
function onekey;
begin
onekey := extonekey(true,prompt,validkeys);
end;
function nonhighlightonekey;
begin
nonhighlightonekey := extonekey(false,prompt,validkeys);
end;
function onekeydef;
var
result: char;
newprompt: string;
newvalid: string;
begin
newprompt := prompt+' ('+default+')';
newvalid := validkeys+' '+chr(13);
result := onekey(newprompt,newvalid);
if result=' ' then
result := default;
if result=chr(13) then
result := default;
onekeydef := result;
end;
function ismailgroup;
begin
ismailgroup := (copy(group,1,length(mailprefix))=mailprefix);
end;
function isnormalgroup;
begin
isnormalgroup := not ismailgroup(group);
end;
function getsyscmd;
var
result: string;
infn: string;
inf: text;
s: string;
begin
result := '';
infn := withbackslash(configdir)+'extern'+'\'+'_system';
safereset(inf,infn);
if fileresult=0 then
begin
while not eof(inf) do
begin
readln(inf,s);
s := ltrim(s);
if getfirstw(s)=cmd then
result := gettag('/command=',s);
end;
end;
getsyscmd := result;
end;
function searchart;
var
result: boolean;
toofar: boolean;
inf: text;
inheaders: boolean;
s: string;
c: char;
lineread: boolean;
faqs: boolean;
begin
result := false;
faqs := (upsearchtext=faqcookie);
safereset(inf,filename);
if fileresult=0 then
begin
inheaders := true;
toofar := false;
while not eof(inf) and not result and not toofar do
begin
if crlf then
readln(inf,s)
else
begin
s := '';
lineread := false;
while not lineread do
begin
read(inf,c);
if c=lf then
lineread := true
else if c<>cr then
begin
s := s+c;
lineread := (length(s)>=255);
end;
end;
end;
if s='' then
inheaders := false;
s := upper(s);
toofar := not inheaders and headersearch;
if faqs then
begin
result := (pos('NEWS.ANSWERS',s)<>0) or
(pos('FAQ',s)<>0) or (pos('FREQUENTLY ASKED Q',s)<>0);
end
else if inheaders then
begin
if headersearch then
result := textintext(upsearchtext,s);
end
else
begin
if not headersearch then
result := textintext(upsearchtext,s);
end;
end;
close(inf);
end;
searchart := result;
end;
function searchnov;
var
result: boolean;
begin
result := true;
searchnov := result;
end;
function ismoderated;
var
result: boolean;
begin
result := false;
if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
result := groupbattr(group,'/mod')
else if xiface=ifaceuupc then
result := {}{}{} false {need to handle this}
else
result := false;
ismoderated := result;
end;
function isheaderinlist;
var
result: boolean;
begin
result := right(header,1)=':';
if result then
result := textintext(':'+upper(header),uheaderlist);
isheaderinlist := result;
end;
function getaddressfromline(s: string): string;
var
result: string;
begin
result := wordwith('@',s);
if result='' then
result := wordwith('!',s);
if (copy(result,1,1)='(') and (copy(result,length(result),1)=')') then
result := copy(result,2,length(result)-2);
if (copy(result,1,1)='<') and (copy(result,length(result),1)='>') then
result := copy(result,2,length(result)-2);
if copy(result,length(result),1)='.' then
result := copy(result,1,length(result)-1);
if copy(result,length(result),1)=',' then
result := copy(result,1,length(result)-1);
getaddressfromline := result;
end;
function isreasonableaddress(addr: string): boolean;
var
result: boolean;
begin
result := true;
if (pos('!',addr)=0) and (pos('@',addr)=0) then
result := false;
if pos('@',addr)<>0 then
if pos('.',addr)=0 then
result := false;
if pos('@.',addr)<>0 then
result := false;
isreasonableaddress := result;
end;
function nthlayout;
var
result: layoutt;
tempi: integer;
begin
result := succ(layoutfirst);
{start at 2, since we already went 1 past the first}
for tempi := 2 to whichlayout do
begin
if succ(result)<>layoutlast then
result := succ(result);
end;
nthlayout := result;
end;
function isabreakline;
{either an empty line or all dashes}
var
result: boolean;
trimmeds: string;
tempint: integer;
begin
result := false;
trimmeds := trim(ltrim(s));
{I realize the first is a special case of the second, but probably faster}
if trimmeds='' then
result := true
else
begin
result := true;
for tempint := 1 to length(trimmeds) do
if trimmeds[tempint]<>'-' then
result := false;
end;
isabreakline := result;
end;
function findproblemwithmessage;
var
result: string;
messagef: text;
done: boolean;
messageline: string;
lineon: integer;
begin
result := '';
safereset(messagef,messagefn);
if fileresult<>0 then
result := 'could not open file!'
else
begin
done := false;
lineon := 0;
while (result='') and not done do
begin
{ran out of headers to check}
if eof(messagef) then
result := 'no body found (no empty line)'
else
begin
readln(messagef,messageline);
inc(lineon);
{once we hit the empty line, we know there's something past the headers}
if messageline='' then
begin
done := true;
{make sure there's something IN the body!}
if eof(messagef) then
result := 'no body found (after empty line)'
else
begin
readln(messagef,messageline);
if messageline='-- ' then
result := 'no body found (just signature)';
end;
end
{all-blank lines are technically legal, but very dangerous to put in}
else if trim(messageline)='' then
result := 'all-blank line needs to be empty instead'
{special-case for mail}
else if (lineon=1) and (copy(messageline,1,5)='From ') then
result := ''
{check only non-continuation lines}
else if messageline=ltrim(messageline) then
begin
if pos(':',messageline)=0 then
result :=
'invalid header line (no colon) '+messageline
else if pos(' ',messageline)=0 then
result :=
'invalid header line (no space) '+messageline
else if pos(' ',messageline)<pos(':',messageline) then
result :=
'invalid header line (space before colon) '+messageline;
end;
end;
end;
close(messagef);
end;
findproblemwithmessage := result;
end;
function toomuchquoting;
var
result: boolean;
totallines: longint;
quotedlines: longint;
messagef: text;
messageline: string;
attributionline: boolean;
seenemptyline: boolean;
seensigline: boolean;
begin
result := false;
attributionline := false;
safereset(messagef,messagefn);
if fileresult<>0 then
result := true {could not open file}
else
begin
totallines := 0;
quotedlines := 0;
seenemptyline := false;
seensigline := false;
while not eof(messagef) do
begin
readln(messagef,messageline);
if messageline='' then
seenemptyline := true
else if messageline='-- ' then
seensigline := true;
if seenemptyline and not seensigline then
if messageline<>'' then
begin
inc(totallines);
if copy(messageline,1,1)='>' then
inc(quotedlines);
if (totallines=1) and (quotedlines=0) then
attributionline := true;
end;
end;
close(messagef);
if (quotedlines>0) then
begin
{ones with just quoted text}
if totallines=quotedlines then
result := true;
{ones with just the attribution line}
if attributionline and (totallines=quotedlines+1) then
result := true;
end;
if totallines>20 then {don't check tiny messages}
if quotedlines>2*totallines then
result := true;
end;
toomuchquoting := result;
end;
function toolongline;
var
result: boolean;
messagef: text;
messageline: string;
seenblank: boolean;
longlinechecknumber: integer;
begin
result := false;
safereset(messagef,messagefn);
seenblank := false;
for longlinechecknumber := 1 to 40 do
if not result then
if not eof(messagef) then
begin
read(messagef,messageline);
if messageline='' then
seenblank := true;
if not eoln(messagef) then
result := true;
{headers>80 chars are ok}
if length(messageline)>maxlen then
if seenblank then
result := true;
if not eof(messagef) then {a bit overcautious I think}
readln(messagef);
end;
close(messagef);
toolongline := result;
end;
function showdebug;
begin
showdebug := isinlist('all',debuglist,':') or isinlist(s,debuglist,':');
end;
function unreadarticlesin;
var
result: articlefilenametype;
hasoverview: boolean;
adir: string;
morearticles: boolean;
fileinfo: searchrec;
anartnum: articlefilenametype;
lastread: articlefilenametype;
begin
result := 0;
lastread := highestreadin(asource,sourcekind);
hasoverview := false;
{note -- for mail groups, ignore the overview file}
if sourcekind=sourcegroup then
adir := getgroupdir(asource)
else if sourcekind=sourcedir then
adir := asource
else if sourcekind=sourcefolder then
adir := '\\\\invalid\\directory.specified\\\\';
if not ismailgroup(asource) then
begin
overviewreset(adir);
if fileresult=0 then
hasoverview := true;
end;
{}{}{}{} {the only thing that calls this can handle extra output here}
{}if hasoverview then xwritess('o',^H);
if hasoverview then
begin
morearticles := not eofoverview;
end
else
begin
findfirst(withbackslash(adir)+articlefilenamepattern,archive,fileinfo);
morearticles := (doserror=0);
end;
while morearticles do
begin
if hasoverview then
begin
anartnum := readoverviewfilenum;
morearticles := not eofoverview;
end
else
begin
anartnum := atol(fileinfo.name);
findnext(fileinfo);
morearticles := (doserror=0);
end;
if anartnum>lastread then
inc(result);
end;
if hasoverview then
closeoverview;
unreadarticlesin := result;
end;
function highestreadin;
var
result: articlefilenametype;
s: string;
begin
result := 0;
if sourcekind<>sourcegroup then
result := 0
else
begin
reset(joinf);
result := impossiblylargeart;
while (result=impossiblylargeart) and not eof(joinf) do
begin
readln(joinf,s);
if getfirstw(s)=asource then
result := getalreadyread(s);
end;
end;
{ only needed for initial single-group stuff }
{
if result=impossiblylargeart then
begin
xwritelnss('not joined to ',asource);
shutdown(1);
end;
}
{ end of only needed part }
highestreadin := result;
end;
function textintext;
begin
if useregex then
textintext := regexintext(asubtext,awholetext)
else
textintext := ( pos(asubtext,awholetext)<>0 );
end;
end.